Attribute VB_Name = "SharedAPI"
'====================================================================================
'APIDecs - Calls to the windows system
'====================================================================================
'NOTE: Please be careful when editing this page. This same module is used both in _
       the game and the level editor.
Option Explicit

'Prevent flicker / refresh window
Public Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long

'--- Pen commands for setting the fore/back colour on surfaces ----------------------
Public Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
Public Declare Function SelectObject Lib "gdi32.dll" (ByVal hDC As Long, ByVal hObject As Long) As Long
Public Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
'Stock objects...
Public Const WHITE_PEN = 6          'A white pen (outline)
Public Const WHITE_BRUSH = 0        'A white brush (fill)
Public Const NULL_BRUSH = 5         'No fill
Public Const DEFAULT_GUI_FONT = 17  'The colour of the system's font
Public Const BLACK_PEN = 7          'A black pen (outline)
Public Const BLACK_BRUSH = 4        'A black brush (fill)
Public Const NULL_PEN = 8           'No outline

'--- Non filled and filled rectangle ------------------------------------------------
Public Declare Function Rectangle Lib "gdi32.dll" (ByVal hDC As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

'--- Mouse Pointer ------------------------------------------------------------------
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Type POINTAPI
    X As Long
    Y As Long
End Type

Private Declare Function LoadCursor Lib "user32.dll" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long
Private Declare Function SetCursor Lib "user32.dll" (ByVal hCursor As Long) As Long
Public Enum IDC
    IDC_APPSTARTING = 32650 'Application starting (arrow and hourglass)
    IDC_ARROW = 32512       'The regular arrow pointer cursor
    IDC_CROSS = 32515       'The cross (precision) cursor
    IDC_IBEAM = 32513       'The I-shaped beam cursor (text editing cursor)
    IDC_ICON = 32641        'Win NT only: An empty cursor
    IDC_NO = 32648          'The "no" symbol cursor (circle with a slash)
    IDC_SIZE = 32640        'Win NT only: The four-pointed resize/move arrow
    IDC_SIZEALL = 32646     'The four-pointed resize/move arrow
    IDC_SIZENESW = 32643    'The double-pointed resize arrow pointing to the upper-right and lower-left.
    IDC_SIZENS = 32645      'The double-pointed resize arrow pointing up and down.
    IDC_SIZENWSE = 32642    'The double-pointed resize arrow pointing to the upper-left and lower-right.
    IDC_SIZEWE = 32644      'The double-pointed resize arrow pointing left and right
    IDC_UPARROW = 32516     'The up-arrow cursor
    IDC_WAIT = 32514        'The wait cursor (hourglass)
    IDC_LINK = 32649        'The hyperlink cursor, undocumented - guessworked by Kroc!
End Enum

'--- Create a font ------------------------------------------------------------------
Public Declare Function CreateFont Lib "gdi32.dll" Alias "CreateFontA" (ByVal nHeight As Long, ByVal nWidth As Long, ByVal nEscapement As Long, ByVal nOrientation As Long, ByVal fnWeight As FW, ByVal fdwItalic As FW, ByVal fdwUnderline As FW, ByVal fdwStrikeOut As FW, ByVal fdwCharSet As FW, ByVal fdwOutputPrecision As FW, ByVal fdwClipPrecision As FW, ByVal fdwQuality As FW, ByVal fdwPitchAndFamily As FW, ByVal lpszFace As String) As Long
Public Enum FW
    FW_DONTCARE = 0
    FW_THIN = 100
    FW_EXTRALIGHT = 200
    FW_ULTRALIGHT = 200
    FW_LIGHT = 300
    FW_NORMAL = 400
    FW_REGULAR = 400
    FW_MEDIUM = 500
    FW_SEMIBOLD = 600
    FW_DEMIBOLD = 600
    FW_BOLD = 700
    FW_EXTRABOLD = 800
    FW_ULTRABOLD = 800
    FW_HEAVY = 900
    FW_BLACK = 900
    ANSI_CHARSET = 0
    ARABIC_CHARSET = 178
    BALTIC_CHARSET = 186
    CHINESEBIG5_CHARSET = 136
    DEFAULT_CHARSET = 1
    EASTEUROPE_CHARSET = 238
    GB2312_CHARSET = 134
    GREEK_CHARSET = 161
    HANGEUL_CHARSET = 129
    HEBREW_CHARSET = 177
    JOHAB_CHARSET = 130
    MAC_CHARSET = 77
    OEM_CHARSET = 255
    RUSSIAN_CHARSET = 204
    SHIFTJIS_CHARSET = 128
    SYMBOL_CHARSET = 2
    THAI_CHARSET = 222
    TURKISH_CHARSET = 162
    OUT_DEFAULT_PRECIS = 0
    OUT_DEVICE_PRECIS = 5
    OUT_OUTLINE_PRECIS = 8
    OUT_RASTER_PRECIS = 6
    OUT_STRING_PRECIS = 1
    OUT_STROKE_PRECIS = 3
    OUT_TT_ONLY_PRECIS = 7
    OUT_TT_PRECIS = 4
    CLIP_DEFAULT_PRECIS = 0
    CLIP_EMBEDDED = 128
    CLIP_LH_ANGLES = 16
    CLIP_STROKE_PRECIS = 2
    ANTIALIASED_QUALITY = 4
    DEFAULT_QUALITY = 0
    DRAFT_QUALITY = 1
    NONANTIALIASED_QUALITY = 3
    PROOF_QUALITY = 2
    DEFAULT_PITCH = 0
    FIXED_PITCH = 1
    VARIABLE_PITCH = 2
    FF_DECORATIVE = 80
    FF_DONTCARE = 0
    FF_ROMAN = 16
    FF_SCRIPT = 64
    FF_SWISS = 32
End Enum

'--- Draw text ----------------------------------------------------------------------
Public Declare Function TextOut Lib "gdi32.dll" Alias "TextOutA" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Public Declare Function SetTextColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long
Public Declare Function SetTextAlign Lib "gdi32.dll" (ByVal hDC As Long, ByVal wFlags As TA) As Long
Public Declare Function SetBkMode Lib "gdi32.dll" (ByVal hDC As Long, bkMode As Long) As Long
Public Enum TA
    TA_BASELINE = 24    'The reference point will be on the baseline of the text.
    TA_BOTTOM = 8       'The reference point will be on the bottom edge of the bounding rectangle of the text.
    TA_CENTER = 6       'The reference point will be horizontally centered along the bounding rectangle of the text.
    TA_LEFT = 0         'The reference point will be on the left edge of the bounding rectangle of the text.
    TA_NOUPDATECP = 0   'Do not set the current point to the reference point.
    TA_RIGHT = 2        'The reference point will be on the right edge of the bounding rectangle of the text.
    TA_RTLREADING = 256 'Win 95/98 only:Display the text right-to-left (if the font is designed for right-to-left reading).
    TA_TOP = 0          'The reference point will be on the top edge of the bounding rectangle of the text.
    TA_UPDATECP = 1     'Set the current point to the reference point.
    TA_TOPCENTER = 6
End Enum

'--- Keyboard State -----------------------------------------------------------------
Public Declare Function GetKeyState Lib "user32.dll" (ByVal nVirtKey As VK) As Integer
Public Enum VK
    VK_LBUTTON = &H1   'Left Mouse Button
    VK_RBUTTON = &H2   'Right Mouse Button
    VK_CANCEL = &H3
    VK_MBUTTON = &H4   'Wheel Click
    VK_BACK = &H8      'Backspace
    VK_TAB = &H9
    VK_CLEAR = &HC
    VK_RETURN = &HD
    VK_SHIFT = &H10
    VK_CONTROL = &H11
    VK_MENU = &H12     'ALT Key
    VK_PAUSE = &H13    'Pause/Break
    VK_CAPITAL = &H14  'CAPS Lock
    VK_ESCAPE = &H1B   'ESC
    VK_SPACE = &H20
    VK_PRIOR = &H21    'Page Up
    VK_NEXT = &H22     'Page Down
    VK_END = &H23
    VK_HOME = &H24
    VK_LEFT = &H25     'Arrow Key Left
    VK_UP = &H26       'Arrow Key Up
    VK_RIGHT = &H27    'Arrow Key Right
    VK_DOWN = &H28     'Arrow Key Down
    VK_SELECT = &H29
    VK_PRINT = &H2A
    VK_EXECUTE = &H2B
    VK_SNAPSHOT = &H2C 'Print Screen
    VK_INSERT = &H2D
    VK_DELETE = &H2E
    VK_HELP = &H2F
    VK_0 = &H30
    VK_1 = &H31
    VK_2 = &H32
    VK_3 = &H33
    VK_4 = &H34
    VK_5 = &H35
    VK_6 = &H36
    VK_7 = &H37
    VK_8 = &H38
    VK_9 = &H39
    VK_A = &H41
    VK_B = &H42
    VK_C = &H43
    VK_D = &H44
    VK_E = &H45
    VK_F = &H46
    VK_G = &H47
    VK_H = &H48
    VK_I = &H49
    VK_J = &H4A
    VK_K = &H4B
    VK_L = &H4C
    VK_M = &H4D
    VK_N = &H4E
    VK_O = &H4F
    VK_P = &H50
    VK_Q = &H51
    VK_R = &H52
    VK_S = &H53
    VK_T = &H54
    VK_U = &H55
    VK_V = &H56
    VK_W = &H57
    VK_X = &H58
    VK_Y = &H59
    VK_Z = &H5A
    VK_STARTKEY = &H5B     'Windows Start Key
    VK_CONTEXTKEY = &H5D   'Context Menu Key (right of AltGr)
    VK_NUMPAD0 = &H60
    VK_NUMPAD1 = &H61
    VK_NUMPAD2 = &H62
    VK_NUMPAD3 = &H63
    VK_NUMPAD4 = &H64
    VK_NUMPAD5 = &H65
    VK_NUMPAD6 = &H66
    VK_NUMPAD7 = &H67
    VK_NUMPAD8 = &H68
    VK_NUMPAD9 = &H69
    VK_MULTIPLY = &H6A
    VK_ADD = &H6B
    VK_SEPARATOR = &H6C
    VK_SUBTRACT = &H6D
    VK_DECIMAL = &H6E
    VK_DIVIDE = &H6F
    VK_F1 = &H70
    VK_F2 = &H71
    VK_F3 = &H72
    VK_F4 = &H73
    VK_F5 = &H74
    VK_F6 = &H75
    VK_F7 = &H76
    VK_F8 = &H77
    VK_F9 = &H78
    VK_F10 = &H79
    VK_F11 = &H7A
    VK_F12 = &H7B
    VK_F13 = &H7C
    VK_F14 = &H7D
    VK_F15 = &H7E
    VK_F16 = &H7F
    VK_F17 = &H80
    VK_F18 = &H81
    VK_F19 = &H82
    VK_F20 = &H83
    VK_F21 = &H84
    VK_F22 = &H85
    VK_F23 = &H86
    VK_F24 = &H87
    VK_NUMLOCK = &H90
End Enum

'--- Get special folders / temp dir -------------------------------------------------
Private Declare Function SHGetSpecialFolderLocation Lib "shell32" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As Long) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Const MAX_LENGTH = 260
Public Enum CSIDL
    CSIDL_PERSONAL = &H5
    CSIDL_DESKTOPDIRECTORY = &H10
    CSIDL_APPDATA = &H1A
    CSIDL_LOCAL_APPDATA = &H1C
End Enum

'====================================================================================
'GetSpecialFolder: Get a folder location from the registry, such as 'My Documents'
'====================================================================================
Public Function GetSpecialFolder(ByVal CSIDL As CSIDL) As String
    Dim sPath As String
    Dim pidl As Long

    'Get the ID list from the Path ID
    If SHGetSpecialFolderLocation(0, CSIDL, pidl) = 0 Then
        'Allocate the space for the path
        sPath = Space$(MAX_LENGTH)
        'Get the real path from the ID list
        If SHGetPathFromIDList(ByVal pidl, ByVal sPath) Then
            'Strip off the trailing null characters
            GetSpecialFolder = Left$(sPath, InStr(sPath, Chr$(0)) - 1)
            'And add a trailing \
            If Right(GetSpecialFolder, 1) <> "\" Then GetSpecialFolder = GetSpecialFolder & "\"
        End If
    End If
End Function

'====================================================================================
'GetTemporaryPath: Get the location of the Windows Temp folder
'====================================================================================
Public Function GetTemporaryPath() As String
    'Create a string long enough
    GetTemporaryPath = String(GetTempPath(0, ""), vbNullChar)
    'Get the Temporary path itself
    GetTempPath Len(GetTemporaryPath), GetTemporaryPath
    'And remove the trailing Null character
    GetTemporaryPath = Left(GetTemporaryPath, Len(GetTemporaryPath) - 1)
End Function

'====================================================================================
'ChangeCursor: Change the mouse pointer's icon
'====================================================================================
Public Sub ChangeCursor(Optional ByVal NewCursor As IDC = IDC_ARROW)
    Static PreviousCursor As Long
    Dim r As Long
    
    'Do not change the cursor to the same thing
    If (PreviousCursor <> NewCursor) Then
        'Set the new cursor
        r = LoadCursor(0, NewCursor): PreviousCursor = SetCursor(r)
    End If
End Sub

'=== END ============================================================================
'This work is licenced under the Creative Commons Attribution 2.5 License
